home *** CD-ROM | disk | FTP | other *** search
/ BCI NET / BCI NET Dec 94.iso / archives / utilities / misc / deft_ii_v13.lha / Deft II / Sources / Work.em < prev   
Encoding:
Text File  |  1994-09-02  |  8.4 KB  |  352 lines
  1. OPT MODULE
  2.  
  3.  
  4. ->*****
  5. ->** External modules
  6. ->*****
  7. MODULE 'libraries/mui'
  8. MODULE 'tools/boopsi' , 'tools/installhook'
  9. MODULE 'utility/tagitem' , 'utility/hooks'
  10. MODULE 'icon' , 'workbench/workbench'
  11. MODULE 'dos/dos' , 'dos/exall'
  12.  
  13. MODULE '*Locale'
  14. MODULE '*Defs'
  15. MODULE '*GUI_MUIB'
  16. MODULE '*Errors'
  17.  
  18.  
  19. ->*****
  20. ->** Error handling
  21. ->*****
  22. RAISE    "MEM"    IF    AllocDosObject()        =    NIL    ,
  23.         "MEM"    IF    ParsePatternNoCase()    =    -1
  24.  
  25.  
  26. ->*****
  27. ->** Constant definitions
  28. ->*****
  29. CONST    EXALL_BUFFER_SIZE    =    1024
  30.  
  31. ENUM    SCAN_OK            =    1    ,
  32.         STOP_SCAN                ,
  33.         INCORRECT_DIR            ,
  34.         SCAN_ERROR
  35.  
  36.  
  37. ->*****
  38. ->** Global variables
  39. ->*****
  40. EXPORT DEF deftII    :    PTR TO obj_app
  41. EXPORT DEF cat        :    PTR TO catalog_DeftII
  42. EXPORT DEF modified    :    LONG
  43.  
  44. DEF icon_pattern    :    PTR TO CHAR
  45. DEF matchfunc_hook    :    PTR TO hook
  46.  
  47.  
  48. /**********************************************************
  49. ** Initializes the icon_pattern to the '#?.info' pattern **
  50. **********************************************************/
  51. EXPORT PROC init_go()
  52.  
  53.     ParsePatternNoCase( '#?.info' , NEW icon_pattern[ 30 ] , 30 )
  54.     installhook( NEW matchfunc_hook , {matchfunc} )
  55.  
  56. ENDPROC
  57.  
  58.  
  59. /**************************************/
  60. /* Like StrCmp() but case insensitive */
  61. /**************************************/
  62. EXPORT PROC str_cmp_no_case( string1 : PTR TO CHAR , string2 : PTR TO CHAR )
  63.  
  64.     DEF same = FALSE
  65.  
  66. ->    DEF i =0 , same = TRUE , upper_char1 = 0 , upper_char2 = 0
  67. ->    WHILE same AND ( string1[ i ] <> 0 ) AND ( string2[ i ] <> 0 )
  68. ->        IF string1[ i ] <> string2[ i ]
  69. ->            upper_char1 := IF ( string1[ i ] >= "a" ) AND ( string1[ i ] <= "z" ) THEN string1[ i ] - 32 ELSE string1[ i ]
  70. ->            upper_char2 := IF ( string2[ i ] >= "a" ) AND ( string2[ i ] <= "z" ) THEN string2[ i ] - 32 ELSE string2[ i ]
  71. ->            IF upper_char1 <> upper_char2 THEN same := FALSE
  72. ->        ENDIF
  73. ->        INC i
  74. ->    ENDWHILE
  75. ->ENDPROC IF ( string1[ i ] = 0 ) AND ( string2[ i ] = 0 ) THEN TRUE ELSE FALSE
  76.  
  77.     MOVE.L    string1 , A1
  78.     MOVE.L    string2 , A2
  79. loop_while:
  80.     MOVE.B    (A1)+ , D1
  81.     MOVE.B    (A2)+ , D2
  82.     TST.B    D1
  83.     BNE.B    second_test
  84.     TST.B    D2
  85.     BNE.B    final_end
  86.     MOVE.L    #-1 , same
  87.     BRA.B    final_end
  88. second_test:
  89.     TST.B    D2
  90.     BEQ.B    final_end
  91. insidewhile:
  92.         CMP.B    D1 , D2
  93.         BEQ.B    loop_while
  94.         CMP.B    #"a" , D1
  95.         BCS.B    char1_ok
  96.         CMP.B    #"z" , D1
  97.         BHI.B    char1_ok
  98.         SUB.B    #32 , D1
  99. char1_ok:
  100.         CMP.B    #"a" , D2
  101.         BCS.B    char2_ok
  102.         CMP.B    #"z" , D2
  103.         BHI.B    char2_ok
  104.         SUB.B    #32 , D2
  105. char2_ok:
  106.         CMP.B    D1 , D2
  107.         BEQ.B    loop_while
  108. final_end:
  109.  
  110. ENDPROC same
  111.  
  112.  
  113. /**************************************************************/
  114. /* The function which runs the icon default tool replacements */
  115. /**************************************************************/
  116. EXPORT PROC go( error_messages )
  117.  
  118.     DEF wrong_path_met = FALSE
  119.     DEF path_str : PTR TO CHAR
  120.     DEF result , i = 0
  121.     DEF return = 0
  122.     DEF old_priority
  123.  
  124.     old_priority := SetTaskPri( FindTask( NIL ) , -5 )
  125.     
  126.     set( deftII.lv_paths , MUIA_List_Quiet , MUI_TRUE )
  127.  
  128.     REPEAT
  129.  
  130.         domethod( deftII.lv_paths , [ MUIM_List_GetEntry , i++ , {path_str} ] )
  131.         IF path_str <> NIL
  132.  
  133.             result := scan_dir( path_str , path_str , error_messages )
  134.  
  135.             IF result = INCORRECT_DIR
  136.  
  137.                 domethod( deftII.lv_paths , [ MUIM_List_Remove , i-- ] )
  138.                 wrong_path_met := TRUE
  139.  
  140.             ENDIF
  141.  
  142.         ENDIF
  143.  
  144.     UNTIL ( path_str = NIL ) OR ( result = STOP_SCAN ) OR ( result = SCAN_ERROR )
  145.  
  146.     IF wrong_path_met
  147.  
  148.         IF error_messages THEN deftII_error( get_string( cat.msg_Wrong_Path_Met ) )
  149.         modified := TRUE
  150.  
  151.     ENDIF
  152.  
  153.     set( deftII.lv_paths , MUIA_List_Quiet , FALSE )
  154.  
  155.     set( deftII.tx_info , MUIA_Text_Contents , get_string( cat.msg_TX_info ) )
  156.  
  157.     set( deftII.gr_paths , MUIA_Disabled , FALSE )
  158.     set( deftII.gr_default_tools , MUIA_Disabled , FALSE )
  159.     set( deftII.bt_go , MUIA_Disabled , FALSE )
  160.     set( deftII.bt_save_prefs , MUIA_Disabled , FALSE )
  161.     set( deftII.bt_about , MUIA_Disabled , FALSE )
  162.     set( deftII.bt_quit , MUIA_Disabled , FALSE )
  163.  
  164.     SetTaskPri( FindTask( NIL ) , old_priority )
  165.  
  166.     IF wrong_path_met THEN return := 10
  167.     IF result = STOP_SCAN THEN return := return + 5
  168.     IF result = SCAN_ERROR THEN return := return + 100
  169.  
  170. ENDPROC return
  171.  
  172.  
  173. /**************************************************************/
  174. /* Recursively scan a directory to replace icon default tools */
  175. /**************************************************************/
  176. PROC scan_dir( dir_name : PTR TO CHAR , previous_path : PTR TO CHAR , error_messages ) HANDLE
  177.  
  178.     DEF eac : PTR TO exallcontrol
  179.     DEF fib : PTR TO fileinfoblock
  180.     DEF entry : PTR TO exalldata
  181.     DEF current_dir = NIL , parent_dir = NIL
  182.     DEF more = FALSE , i , j , found
  183.     DEF icon_name[ 32 ] : STRING , icon : PTR TO diskobject
  184.     DEF def_tool : PTR TO default_tool
  185.     DEF error_buf[ 81 ] : ARRAY OF CHAR , error_num
  186.     DEF complete_path[ 512 ] : STRING
  187.     DEF buffer : PTR TO CHAR
  188.     DEF scan_result , signals
  189.  
  190.     NEW buffer[ EXALL_BUFFER_SIZE ]
  191.     eac := ( eac := NIL ) BUT AllocDosObject( DOS_EXALLCONTROL , NIL )
  192.     fib := ( fib := NIL ) BUT AllocDosObject( DOS_FIB , NIL )
  193.  
  194.     IF ( current_dir := Lock( dir_name , SHARED_LOCK ) ) = NIL
  195.  
  196.         FreeDosObject( DOS_FIB , fib )
  197.         FreeDosObject( DOS_EXALLCONTROL , eac )
  198.         RETURN INCORRECT_DIR
  199.  
  200.     ENDIF
  201.  
  202.     IF Examine( current_dir , fib ) = FALSE
  203.  
  204.         UnLock( current_dir )
  205.         FreeDosObject( DOS_FIB , fib )
  206.         FreeDosObject( DOS_EXALLCONTROL , eac )
  207.         RETURN INCORRECT_DIR
  208.  
  209.     ENDIF
  210.  
  211.     IF fib.direntrytype < 0
  212.  
  213.         UnLock( current_dir )
  214.         FreeDosObject( DOS_FIB , fib )
  215.         FreeDosObject( DOS_EXALLCONTROL , eac )
  216.         RETURN INCORRECT_DIR
  217.  
  218.     ENDIF
  219.  
  220.     FreeDosObject( DOS_FIB , fib )    ;    fib := NIL
  221.     parent_dir := CurrentDir( current_dir )
  222.  
  223.     eac.lastkey := 0
  224.     eac.matchstring := NIL
  225.     eac.matchfunc := matchfunc_hook
  226.  
  227.     REPEAT
  228.  
  229.         more := ExAll( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  230.         error_num := IoErr()
  231.  
  232.         IF domethod( deftII.app , [ MUIM_Application_Input , {signals} ] ) = ID_BT_STOP
  233.  
  234.             IF more THEN ExAllEnd( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  235.             CurrentDir( parent_dir )
  236.             UnLock( current_dir )
  237.             FreeDosObject( DOS_EXALLCONTROL , eac )
  238.             RETURN STOP_SCAN
  239.  
  240.         ENDIF
  241.  
  242.         entry := buffer
  243.  
  244.         FOR i := 1 TO eac.entries
  245.  
  246.             IF entry.type >= 0
  247.  
  248.                 StrCopy( complete_path , previous_path , ALL )
  249.                 AddPart( complete_path , entry.name , 512 )
  250.                 SetStr( complete_path , StrLen( complete_path ) )
  251.  
  252.                 IF ( scan_result := scan_dir( entry.name , complete_path , error_messages ) ) <> SCAN_OK
  253.  
  254.                     ExAllEnd( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  255.                     CurrentDir( parent_dir )
  256.                     UnLock( current_dir )
  257.                     FreeDosObject( DOS_EXALLCONTROL , eac )
  258.                     RETURN scan_result
  259.  
  260.                 ENDIF
  261.  
  262.             ELSE
  263.  
  264.                 IF ( icon := GetDiskObject( StrCopy ( icon_name , entry.name , StrLen( entry.name ) - 5 ) ) ) <> NIL
  265.  
  266.                     IF icon.type = WBPROJECT
  267.  
  268.                         j := 0
  269.                         found := FALSE
  270.  
  271.                         REPEAT
  272.  
  273.                             domethod( deftII.lv_default_tools , [ MUIM_List_GetEntry , j++ , {def_tool} ] )
  274.  
  275.                             IF def_tool <> NIL
  276.  
  277.                                 IF def_tool.pattern
  278.  
  279.                                     found := MatchPatternNoCase( def_tool.pattern , icon.defaulttool )
  280.  
  281.                                 ELSE
  282.  
  283.                                     found := str_cmp_no_case( icon.defaulttool , def_tool.old )
  284.  
  285.                                 ENDIF
  286.  
  287.                             ENDIF
  288.  
  289.                         UNTIL ( def_tool = NIL ) OR found
  290.  
  291.                         IF found AND ( str_cmp_no_case( icon.defaulttool , def_tool.new ) = FALSE )
  292.  
  293.                             icon.defaulttool :=  def_tool.new
  294.                             PutDiskObject( icon_name , icon )
  295.                         
  296.                             StrCopy( complete_path , previous_path , ALL )
  297.                             AddPart( complete_path , entry.name , 512 )
  298.                             SetStr( complete_path , StrLen( complete_path ) )
  299.                             set( deftII.tx_info , MUIA_Text_Contents , complete_path )
  300.  
  301.                         ENDIF
  302.  
  303.                     ENDIF
  304.  
  305.                     FreeDiskObject( icon )
  306.  
  307.                 ENDIF
  308.  
  309.             ENDIF
  310.  
  311.             entry := entry.next
  312.  
  313.         ENDFOR
  314.  
  315.     UNTIL more = FALSE
  316.  
  317.     IF error_num <> ERROR_NO_MORE_ENTRIES
  318.  
  319.         CurrentDir( parent_dir )
  320.         UnLock( current_dir )
  321.         FreeDosObject( DOS_EXALLCONTROL , eac )
  322.  
  323.         Fault( error_num , NIL , error_buf , 80 )
  324.         IF error_messages THEN deftII_error( error_buf )
  325.  
  326.         RETURN SCAN_ERROR
  327.  
  328.     ENDIF
  329.  
  330.     CurrentDir( parent_dir )
  331.     UnLock( current_dir )
  332.     FreeDosObject( DOS_EXALLCONTROL , eac )
  333.     END buffer[ EXALL_BUFFER_SIZE ]
  334.  
  335. EXCEPT
  336.  
  337.     IF more THEN ExAllEnd( current_dir , buffer , EXALL_BUFFER_SIZE , ED_TYPE , eac )
  338.     IF parent_dir THEN CurrentDir( parent_dir )
  339.     IF current_dir THEN UnLock( current_dir )
  340.     IF fib THEN FreeDosObject( DOS_FIB , fib )
  341.     IF eac THEN FreeDosObject( DOS_EXALLCONTROL , eac )
  342.  
  343.     ReThrow()
  344.  
  345. ENDPROC SCAN_OK
  346.  
  347.  
  348. /**********************************************************************
  349. ** Hook function called by ExAll() to see if an entry is a directory **
  350. **********************************************************************/
  351. PROC matchfunc( hook , ptype : PTR TO LONG , ed : PTR TO exalldata ) RETURN ( ed.type >= 0 ) OR ( MatchPatternNoCase( icon_pattern , ed.name ) )
  352.